We’re going to explore relationships between political affiliation, demographics, and COVID-19 statistics. To do this, I’ve pulled together subsets of data from the New York Times’ COVID-19 dataset, the MIT Election Data and Science Lab’s County Presidential Election Returns 2000-2016 dataset, and 2016 data from the US Census.
We also add datasets compiled by [@evangambit](https://github.com/evangambit/JsonOfCounties), including CDC mortality statistics by county, unemployment by county, and preliminary 2020 Presidential election votes by county.
All data is by State and County, so we’ll join all datasets together and select only the columns of interest.
We will now load in all required .csv data files, starting with the COVID-19 dataset. We only select the week leading up to Election 2020 and we compute average new cases and deaths by county.
# set working directory
setwd("data")
# COVID-19 average cases and deaths by state and county in week leading up to 2020 election
data_counties <- read.csv("us-counties.csv") %>%
filter(date >= '2020-10-28') %>%
filter(date <= '2020-11-03') %>%
group_by(state, county, fips) %>%
dplyr::summarize(cases_avg = mean(cases), deaths_covid_avg = mean(deaths)) %>%
select(state, county, fips, cases_avg, deaths_covid_avg)Load the Mask Use dataset and calculate a compsite measure. This dataset contains responses, by county, for percentages of people who report wearing masks “Always”, “Frequently”, “Sometimes”, “Rarely”, and “Never” We define
\[MaskPercentCompliance = ALWAYS + \frac{3}{4}FREQUENTLY + \frac{1}{2}SOMETIMES + \frac{1}{4}RARELY\]
to be the weighted average of these responses. Let’s join this dataset to our COVID-19 data.
setwd("data")
# join mask attitudes data
data_counties <- join(data_counties,
read.csv("./mask-use/mask-use-by-county.csv") %>%
rename(fips = COUNTYFP) %>%
mutate(mask_pct_compliance = (ALWAYS + 0.75*FREQUENTLY + 0.5*SOMETIMES + 0.25*RARELY)),
by = "fips",
type = "left")We now load demographics data for each county in the United States in 2016 so that we can temporally compare to the elections data that we’ll load in next. Once again, we’ll join this to our county table.
setwd("data")
# join 2016 demographics data
data_counties <- join(data_counties,
read.csv("./us-counties-census-data/cc-est2019-alldata-2016-20subset.csv") %>%
filter(YEAR == "2016") %>%
mutate(white_pct_2016 = (WA_MALE + WA_FEMALE) / TOT_POP) %>%
mutate(hispanic_pct_2016 = (H_MALE + H_FEMALE) / TOT_POP) %>%
mutate(afra_black_pct_2016 = (BAC_MALE + BAC_FEMALE) / TOT_POP) %>%
rename(state = STNAME) %>%
mutate(county = str_replace(CTYNAME, " County", "")) %>%
rename(population_2016 = TOT_POP) %>%
select(state, county, population_2016, white_pct_2016,
hispanic_pct_2016, afra_black_pct_2016),
by = c("state", "county"),
type = "left")
# join 2019 demographics data
data_counties <- join(data_counties,
read.csv("./us-counties-census-data/cc-est2019-alldata-2016-20subset.csv") %>%
filter(YEAR == "2019") %>%
mutate(white_pct_2019 = (WA_MALE + WA_FEMALE) / TOT_POP) %>%
mutate(hispanic_pct_2019 = (H_MALE + H_FEMALE) / TOT_POP) %>%
mutate(afra_black_pct_2019 = (BAC_MALE + BAC_FEMALE) / TOT_POP) %>%
rename(state = STNAME) %>%
mutate(county = str_replace(CTYNAME, " County", "")) %>%
rename(population_2019 = TOT_POP) %>%
select(state, county, population_2019, white_pct_2019,
hispanic_pct_2019, afra_black_pct_2019),
by = c("state", "county"),
type = "left")We’ll also load some unemployment demographics.
setwd("data")
# join 2016 unemployment demographics data
data_counties <- join(data_counties,
read.csv("./us-counties-2020-election-unemployment-mortality/unemployment/2016.csv") %>%
rename(state = State) %>%
rename(county = County) %>%
rename(labour_force_2016 = LabourForce) %>%
mutate(unemployment_2016 = Unemployed / labour_force_2016) %>%
select(state, county, labour_force_2016, unemployment_2016),
by = c("state", "county"),
type = "left")
# join 2019 unemployment demographics data
data_counties <- join(data_counties,
read.csv("./us-counties-2020-election-unemployment-mortality/unemployment/2019.csv") %>%
rename(state = State) %>%
rename(county = County) %>%
rename(labour_force_2019 = LabourForce) %>%
mutate(unemployment_2019 = Unemployed / labour_force_2019) %>%
select(state, county, labour_force_2019, unemployment_2019),
by = c("state", "county"),
type = "left")And police shootings data.
setwd("data")
# join 2017 police shootings data
data_counties <- join(data_counties,
read.csv("./us-counties-2020-election-unemployment-mortality/police-shootings/police_shootings.csv") %>%
filter(year == "2017") %>%
filter(status == "armed") %>%
mutate(police_shootings_armed_2017 = count) %>%
mutate(county = tools::toTitleCase(str_replace(county, " county", ""))) %>%
select(state, county, police_shootings_armed_2017),
by = c("state", "county"),
type = "left")
data_counties <- join(data_counties,
read.csv("./us-counties-2020-election-unemployment-mortality/police-shootings/police_shootings.csv") %>%
filter(year == "2017") %>%
filter(status == "unarmed") %>%
mutate(police_shootings_unarmed_2017 = count) %>%
mutate(county = tools::toTitleCase(str_replace(county, " county", ""))) %>%
select(state, county, police_shootings_unarmed_2017),
by = c("state", "county"),
type = "left")
# join 2019 police shootings data
data_counties <- join(data_counties,
read.csv("./us-counties-2020-election-unemployment-mortality/police-shootings/police_shootings.csv") %>%
filter(year == "2019") %>%
filter(status == "armed") %>%
mutate(police_shootings_armed_2019 = count) %>%
mutate(county = tools::toTitleCase(str_replace(county, " county", ""))) %>%
select(state, county, police_shootings_armed_2019),
by = c("state", "county"),
type = "left")
data_counties <- join(data_counties,
read.csv("./us-counties-2020-election-unemployment-mortality/police-shootings/police_shootings.csv") %>%
filter(year == "2019") %>%
filter(status == "unarmed") %>%
mutate(police_shootings_unarmed_2019 = count) %>%
mutate(county = tools::toTitleCase(str_replace(county, " county", ""))) %>%
select(state, county, police_shootings_unarmed_2019),
by = c("state", "county"),
type = "left")And deaths by assault and deaths by suicide. These statistics represent cumulative deaths by county between 1999 and 2016. We estimate a yearly rate by normalizing by current county population, then dividing by (2016-1999+1).
setwd("data")
# join deaths by assault and suicide
data_counties <- join(data_counties,
read.csv("./us-counties-2020-election-unemployment-mortality/mortality-cdc/mortality-1999-2016.csv") %>%
rename(fips = FIPS) %>%
replace(.=="Suppressed", NA) %>%
rename(deaths_assault = DeathAssault) %>%
rename(deaths_suicide = DeathSuicide) %>%
select(fips, deaths_assault, deaths_suicide),
by = "fips",
type = "left")
# refactor death statistics as numeric
data_counties$deaths_assault <- as.numeric(data_counties$deaths_assault)
data_counties$deaths_suicide <- as.numeric(data_counties$deaths_suicide)
data_counties <- data_counties %>%
mutate(norm_deaths_assault_avg = deaths_assault / (18*population_2019)) %>%
mutate(norm_deaths_suicide_avg = deaths_suicide / (18*population_2019))Lastly, we load in data for the 2016 Presidential Election by county. We create a new composite measure
\[RepublicanPercent2016 = \frac{CandidateVotes_{Republican}}{TotalVotes}\] of the percentage of votes in that county that were Republican (Trump) in 2016.
setwd("data")
# join 2016 presidential elections data
data_counties <- join(data_counties,
read.csv("./us-counties-2016-election/countypres_2000-2016.csv") %>%
filter(year == '2016') %>%
filter(party == "republican") %>%
rename(fips = FIPS) %>%
mutate(republican_pct_2016 = candidatevotes / totalvotes) %>%
select(fips, republican_pct_2016),
by = "fips",
type = "left")
# join 2020 presidential elections data
data_counties <- join(data_counties,
read.csv("./us-counties-2020-election-unemployment-mortality/election2020.csv") %>%
mutate(republican_pct_2020 = votes_gop / votes_total) %>%
mutate(county = tools::toTitleCase(str_replace(county, " county", ""))) %>%
select(state, county, republican_pct_2020),
by = c("state", "county"),
type = "left")We select only the attributes of interest. Let’s have a look at our data!
data_counties <- data_counties %>%
mutate(norm_cases_avg = cases_avg / population_2019) %>%
mutate(norm_deaths_covid_avg = deaths_covid_avg / population_2019) %>%
select(state, county, mask_pct_compliance, norm_cases_avg, norm_deaths_covid_avg,
norm_deaths_assault_avg, norm_deaths_suicide_avg, population_2016,
population_2019, white_pct_2016, white_pct_2019, hispanic_pct_2016,
hispanic_pct_2019, afra_black_pct_2016, afra_black_pct_2019, republican_pct_2016,
republican_pct_2020, labour_force_2016, labour_force_2019, unemployment_2016,
unemployment_2019, police_shootings_armed_2017, police_shootings_armed_2019,
police_shootings_unarmed_2017, police_shootings_unarmed_2019)
data_countiesLet’s check the zero-order correlations of our variables of interest :)
cor(na.omit(data_counties[3:25]))## mask_pct_compliance norm_cases_avg
## mask_pct_compliance 1.000000000 -0.20315894
## norm_cases_avg -0.203158945 1.00000000
## norm_deaths_covid_avg 0.157276484 0.52844813
## norm_deaths_assault_avg -0.004926727 0.35367942
## norm_deaths_suicide_avg -0.400160308 -0.14750810
## population_2016 0.361013892 0.05624066
## population_2019 0.365634260 0.05484626
## white_pct_2016 -0.157976885 -0.24718559
## white_pct_2019 -0.166318786 -0.23639077
## hispanic_pct_2016 0.516140332 0.23869146
## hispanic_pct_2019 0.518756651 0.23936841
## afra_black_pct_2016 0.073225796 0.31006820
## afra_black_pct_2019 0.074715066 0.30622994
## republican_pct_2016 -0.529282821 0.02957923
## republican_pct_2020 -0.548642838 0.07920158
## labour_force_2016 0.361674336 0.04793362
## labour_force_2019 0.362502263 0.04662571
## unemployment_2016 0.084576560 0.15024747
## unemployment_2019 0.118224325 0.15908124
## police_shootings_armed_2017 0.207393368 0.06176752
## police_shootings_armed_2019 0.237397695 0.06889112
## police_shootings_unarmed_2017 0.144658528 0.03659297
## police_shootings_unarmed_2019 0.139061876 -0.02493795
## norm_deaths_covid_avg norm_deaths_assault_avg
## mask_pct_compliance 0.15727648 -0.004926727
## norm_cases_avg 0.52844813 0.353679423
## norm_deaths_covid_avg 1.00000000 0.374839792
## norm_deaths_assault_avg 0.37483979 1.000000000
## norm_deaths_suicide_avg -0.17772226 0.033422221
## population_2016 0.07377755 0.153430030
## population_2019 0.07017525 0.148027580
## white_pct_2016 -0.29399492 -0.722108101
## white_pct_2019 -0.28618408 -0.709630000
## hispanic_pct_2016 0.26762922 -0.032260583
## hispanic_pct_2019 0.26676682 -0.034888035
## afra_black_pct_2016 0.31076784 0.777709217
## afra_black_pct_2019 0.30594912 0.770211659
## republican_pct_2016 -0.16761899 -0.298834812
## republican_pct_2020 -0.10809677 -0.292479696
## labour_force_2016 0.06544157 0.143956665
## labour_force_2019 0.05927223 0.135621510
## unemployment_2016 0.29552998 0.352616972
## unemployment_2019 0.31567052 0.358719533
## police_shootings_armed_2017 0.01060301 0.201348694
## police_shootings_armed_2019 0.01784940 0.149967419
## police_shootings_unarmed_2017 0.02287339 0.161204624
## police_shootings_unarmed_2019 0.02295459 0.083172597
## norm_deaths_suicide_avg population_2016
## mask_pct_compliance -0.40016031 0.36101389
## norm_cases_avg -0.14750810 0.05624066
## norm_deaths_covid_avg -0.17772226 0.07377755
## norm_deaths_assault_avg 0.03342222 0.15343003
## norm_deaths_suicide_avg 1.00000000 -0.28612443
## population_2016 -0.28612443 1.00000000
## population_2019 -0.28988959 0.99964016
## white_pct_2016 0.27246084 -0.22616779
## white_pct_2019 0.28048127 -0.22677114
## hispanic_pct_2016 -0.30956084 0.30045896
## hispanic_pct_2019 -0.31173974 0.29813545
## afra_black_pct_2016 -0.27574649 0.11047129
## afra_black_pct_2019 -0.27822790 0.10651539
## republican_pct_2016 0.37621202 -0.42279204
## republican_pct_2020 0.40733067 -0.41322125
## labour_force_2016 -0.28974984 0.99831404
## labour_force_2019 -0.29032730 0.99644177
## unemployment_2016 0.08257531 -0.01572419
## unemployment_2019 0.07189625 -0.03947862
## police_shootings_armed_2017 -0.04778249 0.81166650
## police_shootings_armed_2019 -0.07944646 0.80382662
## police_shootings_unarmed_2017 -0.05178705 0.45458448
## police_shootings_unarmed_2019 -0.03939005 0.48937004
## population_2019 white_pct_2016 white_pct_2019
## mask_pct_compliance 0.36563426 -0.15797689 -0.16631879
## norm_cases_avg 0.05484626 -0.24718559 -0.23639077
## norm_deaths_covid_avg 0.07017525 -0.29399492 -0.28618408
## norm_deaths_assault_avg 0.14802758 -0.72210810 -0.70963000
## norm_deaths_suicide_avg -0.28988959 0.27246084 0.28048127
## population_2016 0.99964016 -0.22616779 -0.22677114
## population_2019 1.00000000 -0.22532253 -0.22621196
## white_pct_2016 -0.22532253 1.00000000 0.99913437
## white_pct_2019 -0.22621196 0.99913437 1.00000000
## hispanic_pct_2016 0.30341795 0.11117527 0.11513228
## hispanic_pct_2019 0.30122512 0.11199033 0.11577665
## afra_black_pct_2016 0.10895756 -0.87853309 -0.87326796
## afra_black_pct_2019 0.10515881 -0.87607451 -0.87198409
## republican_pct_2016 -0.42210567 0.48263136 0.48091889
## republican_pct_2020 -0.41346549 0.50286222 0.50343694
## labour_force_2016 0.99783673 -0.23048713 -0.23171575
## labour_force_2019 0.99693342 -0.22443856 -0.22569504
## unemployment_2016 -0.01969032 -0.15678464 -0.14633761
## unemployment_2019 -0.04354953 -0.14099804 -0.13384893
## police_shootings_armed_2017 0.81349801 -0.16328840 -0.15985703
## police_shootings_armed_2019 0.80792794 -0.15569882 -0.15393912
## police_shootings_unarmed_2017 0.45369077 -0.11352512 -0.11037481
## police_shootings_unarmed_2019 0.49044635 -0.06753537 -0.06644905
## hispanic_pct_2016 hispanic_pct_2019
## mask_pct_compliance 0.51614033 0.51875665
## norm_cases_avg 0.23869146 0.23936841
## norm_deaths_covid_avg 0.26762922 0.26676682
## norm_deaths_assault_avg -0.03226058 -0.03488804
## norm_deaths_suicide_avg -0.30956084 -0.31173974
## population_2016 0.30045896 0.29813545
## population_2019 0.30341795 0.30122512
## white_pct_2016 0.11117527 0.11199033
## white_pct_2019 0.11513228 0.11577665
## hispanic_pct_2016 1.00000000 0.99955237
## hispanic_pct_2019 0.99955237 1.00000000
## afra_black_pct_2016 -0.19663869 -0.19530662
## afra_black_pct_2019 -0.20154811 -0.19996377
## republican_pct_2016 -0.26478400 -0.25928515
## republican_pct_2020 -0.21123009 -0.20653830
## labour_force_2016 0.28118301 0.27860803
## labour_force_2019 0.28785782 0.28540588
## unemployment_2016 0.37518114 0.37752456
## unemployment_2019 0.33169207 0.33292433
## police_shootings_armed_2017 0.19809566 0.19712232
## police_shootings_armed_2019 0.24168617 0.23839674
## police_shootings_unarmed_2017 0.18589117 0.18188740
## police_shootings_unarmed_2019 0.15892164 0.15836909
## afra_black_pct_2016 afra_black_pct_2019
## mask_pct_compliance 0.073225796 0.074715066
## norm_cases_avg 0.310068205 0.306229942
## norm_deaths_covid_avg 0.310767838 0.305949123
## norm_deaths_assault_avg 0.777709217 0.770211659
## norm_deaths_suicide_avg -0.275746492 -0.278227900
## population_2016 0.110471285 0.106515387
## population_2019 0.108957558 0.105158809
## white_pct_2016 -0.878533088 -0.876074511
## white_pct_2019 -0.873267959 -0.871984086
## hispanic_pct_2016 -0.196638690 -0.201548112
## hispanic_pct_2019 -0.195306620 -0.199963771
## afra_black_pct_2016 1.000000000 0.999414685
## afra_black_pct_2019 0.999414685 1.000000000
## republican_pct_2016 -0.372090962 -0.365228057
## republican_pct_2020 -0.403761807 -0.398979253
## labour_force_2016 0.112291911 0.108556788
## labour_force_2019 0.105370122 0.101601141
## unemployment_2016 0.088522689 0.081566449
## unemployment_2019 0.089801010 0.086612168
## police_shootings_armed_2017 0.073908250 0.069124038
## police_shootings_armed_2019 0.086679402 0.084276202
## police_shootings_unarmed_2017 0.044705876 0.039891491
## police_shootings_unarmed_2019 -0.007777714 -0.009761947
## republican_pct_2016 republican_pct_2020
## mask_pct_compliance -0.52928282 -0.548642838
## norm_cases_avg 0.02957923 0.079201582
## norm_deaths_covid_avg -0.16761899 -0.108096773
## norm_deaths_assault_avg -0.29883481 -0.292479696
## norm_deaths_suicide_avg 0.37621202 0.407330666
## population_2016 -0.42279204 -0.413221245
## population_2019 -0.42210567 -0.413465491
## white_pct_2016 0.48263136 0.502862224
## white_pct_2019 0.48091889 0.503436937
## hispanic_pct_2016 -0.26478400 -0.211230090
## hispanic_pct_2019 -0.25928515 -0.206538304
## afra_black_pct_2016 -0.37209096 -0.403761807
## afra_black_pct_2019 -0.36522806 -0.398979253
## republican_pct_2016 1.00000000 0.976694951
## republican_pct_2020 0.97669495 1.000000000
## labour_force_2016 -0.43180880 -0.424946084
## labour_force_2019 -0.42776495 -0.420921252
## unemployment_2016 -0.01669792 0.052341992
## unemployment_2019 -0.06891462 -0.009576923
## police_shootings_armed_2017 -0.29648304 -0.302365578
## police_shootings_armed_2019 -0.28284927 -0.299513707
## police_shootings_unarmed_2017 -0.18306944 -0.186440639
## police_shootings_unarmed_2019 -0.17212198 -0.175683546
## labour_force_2016 labour_force_2019
## mask_pct_compliance 0.36167434 0.36250226
## norm_cases_avg 0.04793362 0.04662571
## norm_deaths_covid_avg 0.06544157 0.05927223
## norm_deaths_assault_avg 0.14395667 0.13562151
## norm_deaths_suicide_avg -0.28974984 -0.29032730
## population_2016 0.99831404 0.99644177
## population_2019 0.99783673 0.99693342
## white_pct_2016 -0.23048713 -0.22443856
## white_pct_2019 -0.23171575 -0.22569504
## hispanic_pct_2016 0.28118301 0.28785782
## hispanic_pct_2019 0.27860803 0.28540588
## afra_black_pct_2016 0.11229191 0.10537012
## afra_black_pct_2019 0.10855679 0.10160114
## republican_pct_2016 -0.43180880 -0.42776495
## republican_pct_2020 -0.42494608 -0.42092125
## labour_force_2016 1.00000000 0.99766865
## labour_force_2019 0.99766865 1.00000000
## unemployment_2016 -0.04007297 -0.04452585
## unemployment_2019 -0.05958353 -0.06656403
## police_shootings_armed_2017 0.80504485 0.81105989
## police_shootings_armed_2019 0.79717569 0.80312119
## police_shootings_unarmed_2017 0.45626247 0.45905557
## police_shootings_unarmed_2019 0.48789620 0.49370649
## unemployment_2016 unemployment_2019
## mask_pct_compliance 0.08457656 0.118224325
## norm_cases_avg 0.15024747 0.159081241
## norm_deaths_covid_avg 0.29552998 0.315670518
## norm_deaths_assault_avg 0.35261697 0.358719533
## norm_deaths_suicide_avg 0.08257531 0.071896252
## population_2016 -0.01572419 -0.039478620
## population_2019 -0.01969032 -0.043549530
## white_pct_2016 -0.15678464 -0.140998035
## white_pct_2019 -0.14633761 -0.133848934
## hispanic_pct_2016 0.37518114 0.331692072
## hispanic_pct_2019 0.37752456 0.332924330
## afra_black_pct_2016 0.08852269 0.089801010
## afra_black_pct_2019 0.08156645 0.086612168
## republican_pct_2016 -0.01669792 -0.068914621
## republican_pct_2020 0.05234199 -0.009576923
## labour_force_2016 -0.04007297 -0.059583527
## labour_force_2019 -0.04452585 -0.066564032
## unemployment_2016 1.00000000 0.893681597
## unemployment_2019 0.89368160 1.000000000
## police_shootings_armed_2017 0.04639305 0.046895644
## police_shootings_armed_2019 -0.01588018 -0.015073580
## police_shootings_unarmed_2017 0.05131676 0.016445653
## police_shootings_unarmed_2019 0.07989409 0.112107465
## police_shootings_armed_2017
## mask_pct_compliance 0.20739337
## norm_cases_avg 0.06176752
## norm_deaths_covid_avg 0.01060301
## norm_deaths_assault_avg 0.20134869
## norm_deaths_suicide_avg -0.04778249
## population_2016 0.81166650
## population_2019 0.81349801
## white_pct_2016 -0.16328840
## white_pct_2019 -0.15985703
## hispanic_pct_2016 0.19809566
## hispanic_pct_2019 0.19712232
## afra_black_pct_2016 0.07390825
## afra_black_pct_2019 0.06912404
## republican_pct_2016 -0.29648304
## republican_pct_2020 -0.30236558
## labour_force_2016 0.80504485
## labour_force_2019 0.81105989
## unemployment_2016 0.04639305
## unemployment_2019 0.04689564
## police_shootings_armed_2017 1.00000000
## police_shootings_armed_2019 0.77483528
## police_shootings_unarmed_2017 0.33731824
## police_shootings_unarmed_2019 0.53540965
## police_shootings_armed_2019
## mask_pct_compliance 0.23739770
## norm_cases_avg 0.06889112
## norm_deaths_covid_avg 0.01784940
## norm_deaths_assault_avg 0.14996742
## norm_deaths_suicide_avg -0.07944646
## population_2016 0.80382662
## population_2019 0.80792794
## white_pct_2016 -0.15569882
## white_pct_2019 -0.15393912
## hispanic_pct_2016 0.24168617
## hispanic_pct_2019 0.23839674
## afra_black_pct_2016 0.08667940
## afra_black_pct_2019 0.08427620
## republican_pct_2016 -0.28284927
## republican_pct_2020 -0.29951371
## labour_force_2016 0.79717569
## labour_force_2019 0.80312119
## unemployment_2016 -0.01588018
## unemployment_2019 -0.01507358
## police_shootings_armed_2017 0.77483528
## police_shootings_armed_2019 1.00000000
## police_shootings_unarmed_2017 0.36878310
## police_shootings_unarmed_2019 0.47003045
## police_shootings_unarmed_2017
## mask_pct_compliance 0.14465853
## norm_cases_avg 0.03659297
## norm_deaths_covid_avg 0.02287339
## norm_deaths_assault_avg 0.16120462
## norm_deaths_suicide_avg -0.05178705
## population_2016 0.45458448
## population_2019 0.45369077
## white_pct_2016 -0.11352512
## white_pct_2019 -0.11037481
## hispanic_pct_2016 0.18589117
## hispanic_pct_2019 0.18188740
## afra_black_pct_2016 0.04470588
## afra_black_pct_2019 0.03989149
## republican_pct_2016 -0.18306944
## republican_pct_2020 -0.18644064
## labour_force_2016 0.45626247
## labour_force_2019 0.45905557
## unemployment_2016 0.05131676
## unemployment_2019 0.01644565
## police_shootings_armed_2017 0.33731824
## police_shootings_armed_2019 0.36878310
## police_shootings_unarmed_2017 1.00000000
## police_shootings_unarmed_2019 0.22019501
## police_shootings_unarmed_2019
## mask_pct_compliance 0.139061876
## norm_cases_avg -0.024937951
## norm_deaths_covid_avg 0.022954593
## norm_deaths_assault_avg 0.083172597
## norm_deaths_suicide_avg -0.039390048
## population_2016 0.489370038
## population_2019 0.490446347
## white_pct_2016 -0.067535373
## white_pct_2019 -0.066449051
## hispanic_pct_2016 0.158921640
## hispanic_pct_2019 0.158369092
## afra_black_pct_2016 -0.007777714
## afra_black_pct_2019 -0.009761947
## republican_pct_2016 -0.172121979
## republican_pct_2020 -0.175683546
## labour_force_2016 0.487896199
## labour_force_2019 0.493706491
## unemployment_2016 0.079894089
## unemployment_2019 0.112107465
## police_shootings_armed_2017 0.535409652
## police_shootings_armed_2019 0.470030454
## police_shootings_unarmed_2017 0.220195007
## police_shootings_unarmed_2019 1.000000000We’re going to plot these correlations with a heat map to better visualize.
#cor(na.omit(data_counties[3:25])) %>% add_histogram2d(colorscale = "Blues")Anddd… Let’s get into some plotting!
# clean the counties data for this chart
counties <- data_counties %>% filter(!is.na(norm_cases_avg)) %>% filter(!is.na(mask_pct_compliance)) %>% ungroup()
# compute regressions and correlations
regression <- lm(norm_cases_avg ~ mask_pct_compliance, data = counties)
correlation <- rcorr(data_counties$mask_pct_compliance, data_counties$norm_cases_avg)
# build chart
counties %>%
plot_ly(x = ~mask_pct_compliance) %>%
add_markers(y = ~norm_cases_avg) %>%
add_lines(x = ~mask_pct_compliance, y = fitted(regression)) %>%
layout(title = paste0("COVID-19 Cases by Mask Compliance (r = ",
round(correlation$r["x","y"], 3), ", p = ",
round(correlation$P["x","y"], 3), ")"),
xaxis = list(title = "Mask Compliance %"),
yaxis = list(title = "Average Cases %"),
showlegend = FALSE)rm(counties)
rm(regression)
rm(correlation)# clean the counties data for this chart
counties <- data_counties %>% filter(!is.na(norm_cases_avg)) %>% filter(!is.na(white_pct_2016)) %>% ungroup()
# compute regressions and correlations
regression <- lm(norm_cases_avg ~ white_pct_2016, data = counties)
correlation <- rcorr(data_counties$white_pct_2016, data_counties$norm_cases_avg)
# build chart
counties %>%
plot_ly(x = ~white_pct_2016) %>%
add_markers(y = ~norm_cases_avg) %>%
add_lines(x = ~white_pct_2016, y = fitted(regression)) %>%
layout(title = paste0("COVID-19 Cases by Demographics (r = ",
round(correlation$r["x","y"], 3), ", p = ",
round(correlation$P["x","y"], 3), ")"),
xaxis = list(title = "White % (2016)"),
yaxis = list(title = "Average Cases %"),
showlegend = FALSE)rm(counties)
rm(regression)
rm(correlation)# clean the counties data for this chart
counties <- data_counties %>% filter(!is.na(norm_cases_avg)) %>% filter(!is.na(republican_pct_2016)) %>% ungroup()
# compute regressions and correlations
regression <- lm(norm_cases_avg ~ republican_pct_2016, data = counties)
correlation <- rcorr(data_counties$republican_pct_2016, data_counties$norm_cases_avg)
# build chart
counties %>%
plot_ly(x = ~republican_pct_2016) %>%
add_markers(y = ~norm_cases_avg) %>%
add_lines(x = ~republican_pct_2016, y = fitted(regression)) %>%
layout(title = paste0("COVID-19 Cases by Political Affiliation (r = ",
round(correlation$r["x","y"], 3), ", p = ",
round(correlation$P["x","y"], 3), ")"),
xaxis = list(title = "Republican Voters % (2016)"),
yaxis = list(title = "Average Cases %"),
showlegend = FALSE)rm(counties)
rm(regression)
rm(correlation)# clean the counties data for this chart
counties <- data_counties %>% filter(!is.na(white_pct_2016)) %>% filter(!is.na(mask_pct_compliance)) %>% ungroup()
# compute regressions and correlations
regression <- lm(mask_pct_compliance ~ white_pct_2016, data = counties)
correlation <- rcorr(data_counties$white_pct_2016, data_counties$mask_pct_compliance)
# build chart
counties %>%
plot_ly(x = ~white_pct_2016) %>%
add_markers(y = ~mask_pct_compliance) %>%
add_lines(x = ~white_pct_2016, y = fitted(regression)) %>%
layout(title = paste0("Mask Compliance by Demographics (r = ",
round(correlation$r["x","y"], 3), ", p = ",
round(correlation$P["x","y"], 3), ")"),
xaxis = list(title = "White % (2016)"),
yaxis = list(title = "Mask Compliance %"),
showlegend = FALSE)rm(counties)
rm(regression)
rm(correlation)# clean the counties data for this chart
counties <- data_counties %>% filter(!is.na(republican_pct_2016)) %>%
filter(!is.na(mask_pct_compliance)) %>% ungroup()
# compute regressions and correlations
regression <- lm(mask_pct_compliance ~ republican_pct_2016, data = counties)
correlation <- rcorr(data_counties$republican_pct_2016, data_counties$mask_pct_compliance)
# build chart
counties %>%
plot_ly(x = ~republican_pct_2016) %>%
add_markers(y = ~mask_pct_compliance) %>%
add_lines(x = ~republican_pct_2016, y = fitted(regression)) %>%
layout(title = paste0("Mask Compliance by Political Affiliation (r = ",
round(correlation$r["x","y"], 3), ", p = ",
round(correlation$P["x","y"], 3), ")"),
xaxis = list(title = "Republican Voters % (2016)"),
yaxis = list(title = "Mask Compliance %"),
showlegend = FALSE)rm(counties)
rm(regression)
rm(correlation)# clean the counties data for this chart
counties <- data_counties %>% filter(!is.na(white_pct_2016)) %>%
filter(!is.na(republican_pct_2016)) %>% ungroup()
# compute regressions and correlations
regression <- lm(republican_pct_2016 ~ white_pct_2016, data = counties)
correlation <- rcorr(data_counties$white_pct_2016, data_counties$republican_pct_2016)
# build chart
counties %>%
plot_ly(x = ~white_pct_2016) %>%
add_markers(y = ~republican_pct_2016) %>%
add_lines(x = ~white_pct_2016, y = fitted(regression)) %>%
layout(title = paste0("Political Affiliation by Demographics (r = ",
round(correlation$r["x","y"], 3), ", p = ",
round(correlation$P["x","y"], 3), ")"),
xaxis = list(title = "White % (2016)"),
yaxis = list(title = "Republican Voters % (2016)"),
showlegend = FALSE)rm(counties)
rm(regression)
rm(correlation)